home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / tpascal / hotmap / frusamap.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-27  |  5.1 KB  |  186 lines
  1. unit Frusamap;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, VBXCtrl, Hotmap, StdCtrls, ExtCtrls, ColorGrd, Pict;
  8.  
  9. type
  10.   TUsaMap = class(TForm)
  11.     HotMap1: THotMap;
  12.     Memo1: TMemo;
  13.     ComboBox1: TComboBox;
  14.     ListBox1: TListBox;
  15.     GroupBox1: TGroupBox;
  16.     RgnColor: TColorGrid;
  17.     Label3: TEdit;
  18.     Label1: TEdit;
  19.     Button1: TButton;
  20.     Text2: TEdit;
  21.     BiPict1: TBiPict;
  22.     CheckBox1: TCheckBox;
  23.     CheckBox2: TCheckBox;
  24.     RadioGroup1: TRadioGroup;
  25.     Edit1: TEdit;
  26.     Label2: TLabel;
  27.     Label4: TLabel;
  28.     Label5: TLabel;
  29.     Button2: TButton;
  30.     procedure FormCreate(Sender: TObject);
  31.     procedure ComboBox1Click(Sender: TObject);
  32.     procedure HotMap1RegionMouseDown(Sender: TObject;
  33.       var RegionNum: Single; var Button: Integer);
  34.     procedure HotMap1RegionMouseOver(Sender: TObject;
  35.       var RegionNum: Single);
  36.     procedure Button1Click(Sender: TObject);
  37.     procedure RadioGroup1Click(Sender: TObject);
  38.     procedure CheckBox2Click(Sender: TObject);
  39.     procedure CheckBox1Click(Sender: TObject);
  40.     procedure Button2Click(Sender: TObject);
  41.     procedure RgnColorClick(Sender: TObject);
  42.     procedure FormResize(Sender: TObject);
  43.     procedure FormShow(Sender: TObject);
  44.   private
  45.      OffsetX: Integer;
  46.      OffsetY: Integer;
  47.     { Private declarations }
  48.   public
  49.     { Public declarations }
  50.   end;
  51.  
  52. var
  53.   UsaMap: TUsaMap;
  54.  
  55. implementation
  56.  
  57. {$R *.DFM}
  58.  
  59. procedure TUsaMap.FormCreate(Sender: TObject);
  60.     var     DtFl:     TVBString;
  61.             n:    Integer;
  62. begin
  63.         Memo1.Text := 'Use USA map to learn about HotMap custom control. ';
  64.         Memo1.Text := Memo1.Text + 'Click anywhere on USA map. Choose a new Fill Style. ';
  65.         Memo1.Text := Memo1.Text + 'Select any state from ''Show State'' combobox. Try to resize the form. ';
  66.         Memo1.Text := Memo1.Text + 'Switch ''Color'' CheckBox and choose any color. ';
  67.         Memo1.Text := Memo1.Text + 'Switch ''Drag'' CheckBox and try to drag any region.';
  68.  
  69.         DtFl    := 'USAMAP.HMD';
  70.         HotMap1.DataFile := DtFl;
  71.         HotMap1.Action := 4;
  72. {        DtFl    := 'USAMAP.BMP';
  73.         HotMap1.BmpName := DtFl;
  74.  }
  75.         Edit1.Text := IntToStr(HotMap1.NumOfRgns);
  76.  
  77.         For n := 0 To (HotMap1.NumOfRgns - 1) Do
  78.              ComboBox1.Items.Add(HotMap1.RegionString[n]);
  79. end;
  80.  
  81. procedure TUsaMap.ComboBox1Click(Sender: TObject);
  82.     var n:    Integer;
  83. begin
  84.     For n := 0 To (HotMap1.NumOfRgns - 1) Do
  85.     begin
  86.       If ComboBox1.Text = HotMap1.RegionString[n] Then
  87.       begin
  88.         HotMap1.CurrentRgn := (n + 1);
  89.         HotMap1.Action := 1;
  90.         Exit;
  91.       end;
  92.     end;
  93. end;
  94.  
  95. procedure TUsaMap.HotMap1RegionMouseDown(Sender: TObject;
  96.   var RegionNum: Single; var Button: Integer);
  97.   var Rn:    Integer;
  98. begin
  99.  
  100.     Rn := Round(RegionNum);
  101.     Label3.Text := IntToStr(Rn);
  102.     Case Rn of
  103.         0:
  104.             Label1.Text := '';
  105.         else
  106.             Label1.Text := HotMap1.RegionString[Rn - 1];
  107.             ListBox1.Items.Add(HotMap1.RegionString[Rn - 1]);
  108.  
  109.             {If was clicked in CA then chang the cursor
  110.             If HotMap1.RegionString(RegionNum - 1) = "CA" Then
  111.                 HotMap1.MouseCursor = Picture1;
  112.             Else
  113.                 HotMap1.MouseCursor = Picture2;}
  114.     end;
  115.  
  116. end;
  117.  
  118. procedure TUsaMap.HotMap1RegionMouseOver(Sender: TObject;
  119.   var RegionNum: Single);
  120. begin
  121.     Text2.Text := HotMap1.RegionString[Round(RegionNum) - 1];
  122. end;
  123.  
  124. procedure TUsaMap.Button1Click(Sender: TObject);
  125. begin
  126.     ListBox1.Clear
  127. end;
  128.  
  129. procedure TUsaMap.RadioGroup1Click(Sender: TObject);
  130. begin
  131.     HotMap1.FillType := RadioGroup1.ItemIndex;
  132. end;
  133.  
  134. procedure TUsaMap.CheckBox2Click(Sender: TObject);
  135. begin
  136.     HotMap1.DragAllowed := CheckBox2.Checked;
  137. end;
  138.  
  139. procedure TUsaMap.CheckBox1Click(Sender: TObject);
  140. begin
  141.     HotMap1.ColorMode := CheckBox1.Checked;
  142.     GroupBox1.Visible := CheckBox1.Checked;
  143. end;
  144.  
  145. procedure TUsaMap.Button2Click(Sender: TObject);
  146.     var n:    Integer;
  147. begin
  148.     For n := 0 To (HotMap1.NumOfRgns - 1) Do
  149.         HotMap1.RegionColor[n] := RGB(Random(255), Random(255), Random(255));
  150. {        HotMap1.RegionColor[n] := Random($FFFFFF + 1);
  151.     HotMap1.RegionColor[n] := Color(Random(256);}
  152.  
  153. end;
  154.  
  155. procedure TUsaMap.RgnColorClick(Sender: TObject);
  156.   var I, Code: Integer;
  157. begin
  158.   Val(Label3.Text, I, Code);
  159.   if I > 0 then
  160.       HotMap1.RegionColor[I - 1]  := RgnColor.ForegroundColor;
  161. end;
  162.  
  163. procedure TUsaMap.FormResize(Sender: TObject);
  164. begin
  165.     If self.WindowState <> wsMinimized Then
  166.         {Do not let user to make to small picture, to avoid loosing scaling}
  167.         If ((self.Width - OffsetX) > 50) And ((self.Height - OffsetY) > 50) Then
  168.         begin
  169.             HotMap1.Width := self.Width - OffsetX;
  170.             HotMap1.Height := self.Height - OffsetY;
  171.     end;
  172. end;
  173.  
  174. procedure TUsaMap.FormShow(Sender: TObject);
  175. begin
  176.         HotMap1.FillType := 3;
  177.          RadioGroup1.ItemIndex := 3;
  178.         HotMap1.MouseCursor := BiPict1.Picture;
  179.         HotMap1.MouseHotX := 19;
  180.         HotMap1.MouseHotY := 0;
  181.         OffsetX := (self.Width - HotMap1.Width);
  182.         OffsetY := (self.Height - HotMap1.Height);
  183. end;
  184.  
  185. end.
  186.